home *** CD-ROM | disk | FTP | other *** search
/ BMUG Revelations / BMUG Revelations.toast / Programming / Programming Languages / Yerk 3.64 / Toolbox Classes / Interval < prev    next >
Text File  |  1993-01-28  |  2KB  |  58 lines
  1. \ interval  - interval timer stuff
  2. \ 12/14/84  cbd Version 1
  3. \ 10/15/85  cdn Fixed print: method in Timer
  4. \  1/31/87    rfl added clear:
  5. \  6/13/89    rfl added pause
  6. \ 12/12/90    rfl    modified when: to not depend on events...looks at global 'ticks'
  7. \                also changed pause and wait to >= compares
  8. \  2/02/91    rfl    fixed stop:
  9. \  1/28/93    rfl    added sync:
  10. Decimal
  11.  
  12. \ define an interval timer class
  13. :CLASS Timer  <Super Object
  14.  
  15.     Var        Ticks    \ store system ticks=60ths
  16.     Int        On        \ true = timing
  17.  
  18.     \ ( -- ticks )  return system ticks
  19.     :M  WHEN:  global ticks @   ;M
  20.  
  21.     \ start timing an interval
  22.     :M  START:  when: self put: ticks  1 put: on  ;M
  23.  
  24.     \ stop the clock, and replace ticks with the interval
  25.     :M  STOP:   get: on
  26.         IF when: self get: ticks - put: ticks  clear: on THEN ;M
  27.  
  28.     \ ( -- secs*60 ) get the current value of the clock, but keep timing if on
  29.     :M  GET:  get: on
  30.         IF  when: self  get: ticks -
  31.         ELSE  get: ticks  THEN  ;M
  32.  
  33.     \ print the current value of the timer, in seconds and hundredths
  34.     :M  PRINT:  get: self  60 /mod 3 .R  $ 2e emit  100 * 60 /
  35.         2 .R ."  Seconds " ;M
  36.  
  37.     :M  CLEAR: clear: on clear: ticks ;M
  38.  
  39.     \ sync to vbl tick
  40.     :M  SYNC: global ticks @ put: ticks BEGIN global ticks @ get: ticks > UNTIL ;M
  41.  
  42. ;CLASS
  43.  
  44. Timer sysTimer    \ create an instance of Timer
  45.  
  46. \ ( -- f OR key t )  listen to event queue, true if key event
  47. : ?Key  next: fEvent  ;
  48.  
  49. \ general purpose pause where time is in 1/60ths of second - process events
  50. timer pTimer
  51. : pause { time -- } start: pTimer
  52.     BEGIN next: fevent IF 2drop THEN get: pTimer time >= UNTIL ;
  53.  
  54. \ same as pause, but don't process events
  55. : wait { time -- } start: pTimer
  56.     BEGIN get: pTimer time >= UNTIL ;
  57.  
  58.